home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / halcn305.zip / SMPLSTUF.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-16  |  22KB  |  725 lines
  1. UNIT SmplStuf;
  2. {-----------------------------------------------------------------------------
  3.                              Item Selection Routines
  4.  
  5.        SmplStuf Copyright (c)  Richard F. Griffin
  6.  
  7.        14 April 1993
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles routines to allow display of lists and selection
  14.        of items from the list.  These routines are provided to show how
  15.        GS_dBase units can be used in an application.  They are offered
  16.        with no guarantee or technical support.
  17.  
  18.              -----   NOT FOR USE IN A WINDOWS ENVIRONMENT   -----
  19.  
  20.    Changes:
  21.  
  22. -----------------------------------------------------------------------------}
  23.  
  24. INTERFACE
  25.  
  26. USES
  27.    Crt,
  28.    Dos,
  29.    GSOB_Inx,
  30.    GSOB_Str,
  31.    GSOB_Dte,
  32.    GSOB_Var;
  33.  
  34. const
  35.    BeepTime = 200;
  36.    BeepFreq = 600;
  37.  
  38.    Kbd_Null = #0;                     {Null Character}
  39.    Kbd_Nul  = #3;                     {Another Null}
  40.    Kbd_Bsp  = #8;                     {Backspace}
  41.    Kbd_Tab  = #9;                     {Tab}
  42.    Kbd_Ret  = #13;                    {Return}
  43.    Kbd_RTb  = #15;                    {Shift-Tab}
  44.    Kbd_Esc  = #27;                    {Escape}
  45.    Kbd_F1   = #59;                    {F1}
  46.    Kbd_F2   = #60;                    {F2}
  47.    Kbd_F3   = #61;                    {F3}
  48.    Kbd_F4   = #62;                    {F4}
  49.    Kbd_F5   = #63;                    {F5}
  50.    Kbd_F6   = #64;                    {F6}
  51.    Kbd_F7   = #65;                    {F7}
  52.    Kbd_F8   = #66;                    {F8}
  53.    Kbd_F9   = #67;                    {F9}
  54.    Kbd_F10  = #68;                    {F10}
  55.    Kbd_Home = #71;                    {Home}
  56.    Kbd_UpAr = #72;                    {Up Arrow}
  57.    Kbd_PgUp = #73;                    {Page Up}
  58.    Kbd_LfAr = #75;                    {Left Arrow}
  59.    Kbd_RtAr = #77;                    {Right Arrow}
  60.    Kbd_End  = #79;                    {End}
  61.    Kbd_DnAr = #80;                    {Down Arrow}
  62.    Kbd_PgDn = #81;                    {Page Down}
  63.    Kbd_Ins  = #82;                    {Insert}
  64.    Kbd_Del  = #83;                    {Delete}
  65.    Kbd_CLAr = #115;                   {Ctrl-Left Arrow}
  66.    Kbd_CRAr = #116;                   {Ctrl-Right Arrow}
  67.    Kbd_CEnd = #117;                   {Ctrl-End}
  68.    Kbd_CPDn = #118;                   {Ctrl-Page Down}
  69.    Kbd_CHom = #119;                   {Ctrl-Home}
  70.    Kbd_CPUp = #132;                   {Ctrl-Page up}
  71.  
  72. var
  73.  
  74.    GS_KeyI_Esc,
  75.    GS_KeyI_Fuc,
  76.    GS_KeyI_Ins,
  77.    GS_KeyI_Ret   : boolean;
  78.    GS_KeyI_Chr   : char;
  79.    GS_KeyI_Str   : string[255];
  80.    EscStrSave    : string;
  81.    AdditionalKeys: string;
  82.    EditADate     : boolean;
  83.    Wait_CR       : boolean;
  84.  
  85. function  EditString(T : string; x, y, l : integer) : string;
  86. Procedure SetScreenColors(fgn,hcl,bgn,ifgn,ibgn : byte);
  87. Procedure SetHiMode;
  88. Procedure SetIvMode;
  89. Procedure SetNmMode;
  90. Function  GetKey : char;
  91. procedure SoundBell( t,h : word);
  92. procedure WaitForKey;
  93.  
  94. function  GS_Pick_Line(InxObj: GSP_IndxColl; var sitem: word): GSP_IndxEtry;
  95. function  GS_Pick_Row(InxObj: GSP_IndxColl; var sitem: word): GSP_IndxEtry;
  96. function  GS_FindFiles(pth, fname : string; LookElseWhere : boolean): string;
  97. function  GS_Date_Read(x,y: integer;defdate: longint): longint;
  98. procedure MakeABox(boxname : string);
  99.  
  100. implementation
  101.  
  102. var
  103.    CPos    : Word;             {Holds the position within the string}
  104.    Ch      : Char;             {Holds the last character read}
  105.    First   : boolean;          {Flag to detect the first real character}
  106.    Modified: boolean;          {Flag to signal whether the field was}
  107.                                {mofified, or the default was returned}
  108.    Fgnd,
  109.    HiLite,
  110.    Bgnd,
  111.    IFgnd,
  112.    IBgnd        : byte;
  113.  
  114.    icnt         : longint;
  115.    clth         : word;
  116.    GS_FileDrvCnt : word;
  117.    GS_FileDrvTab : array[0..127] of char;
  118.    regs          : registers;
  119.    cdriv         : byte;
  120.    tdrv          : byte;
  121.  
  122. procedure Check_Func_Keys;
  123. var i : integer;
  124. begin
  125.    for i := 1 to length(AdditionalKeys) do
  126.       if AdditionalKeys[i] = ch then ch := KBD_Ret;
  127.    case ch of
  128.      Kbd_Home  : CPos := 1;
  129.      Kbd_End   : CPos := Succ(Length(GS_KeyI_Str));
  130.      Kbd_Ins   : begin
  131.                     if not EditADate then GS_KeyI_Ins := not GS_KeyI_Ins;
  132.                  end;
  133.     Kbd_LfAr  : if CPos > 1 then Dec(CPos);
  134.     Kbd_RtAr  : if CPos <= Length(GS_KeyI_Str) then Inc(CPos);
  135.     Kbd_Bsp   : begin
  136.                    if not EditADate then
  137.                    begin
  138.                       Delete(GS_KeyI_Str, Pred(CPos), 1);
  139.                       if CPos > 1 then Dec(CPos);
  140.                    end
  141.                    else
  142.                    begin
  143.                       if (GS_KeyI_Str[CPos] in ['0'..'9']) then
  144.                          GS_KeyI_Str[CPos] := ' ';
  145.                       if CPos > 1 then dec(CPos);
  146.                       if not (GS_KeyI_Str[CPos] in [' ','0'..'9']) then
  147.                          dec(CPos);
  148.                    end;
  149.                 end;
  150.     Kbd_Del   : begin
  151.                    if not EditADate then
  152.                       if CPos <= Length(GS_KeyI_Str) then
  153.                          Delete(GS_KeyI_Str, CPos, 1);
  154.                  end;
  155.     Kbd_Tab,                  {Tab Key}
  156.     Kbd_Rtb,                  {Shift-Tab key}
  157.     Kbd_UpAr,                 {Up Arrow}
  158.     Kbd_DnAr,                 {Down Arrow}
  159.     Kbd_PgUp,                 {Page Up}
  160.     Kbd_PgDn,                 {Page Down}
  161.     Kbd_CEnd,                 {Ctrl-End}
  162.     Kbd_CHom,                 {Ctrl-Home}
  163.     Kbd_Ret   : begin         {Return}
  164.                    GS_KeyI_Ret := true;   {Set Return Flag true}
  165.                    Ch := Kbd_Ret;
  166.                 end;
  167.     Kbd_Esc   : begin         {Escape Key causes an exit with the}
  168.                               {original default value returned}
  169.                    EscStrSave := GS_KeyI_Str;
  170.                    GS_KeyI_Str := '';
  171.                    GS_KeyI_Esc := True;
  172.                 end;
  173.    end;
  174. end;
  175.  
  176. function EditString(T : string; x, y, l : integer) : string;
  177. var
  178.    dix : integer;
  179. begin
  180.    GS_KeyI_Ins := True;               {Start in insert mode}
  181.    if EditADate then GS_KeyI_Ins := false;
  182.    GS_KeyI_Esc := False;              {Set the Escape flag false}
  183.    GS_KeyI_Ret := false;              {Set Return flag false}
  184.    Modified := false;                 {Flag for field not modified}
  185.    First := True;                     {Flag set for no characters yet entered}
  186.    GS_KeyI_Str := T;                  {Store default value in work string}
  187.    CPos := 1;                         {Set cursor position on line to start}
  188.    repeat
  189.       gotoxy(x,y);                    {Go to proper location on screen}
  190.       write(GS_KeyI_Str,'':l-length(GS_KeyI_Str));
  191.                                       {Display the work string}
  192.       GotoXY(CPos+x-1, y);            {Go to current position in the string}
  193.       Ch := GetKey;                   {Get the next keyboard entry}
  194.       if (GS_KeyI_Fuc) or (Ch in [#0..#31]) then
  195.                                       {See if function key or control char}
  196.       begin
  197.          Check_Func_Keys;             {If it is, go process it.}
  198.       end
  199.       else                            {Otherwise add character to the string}
  200.       begin
  201.          if EditADate and ((Ch < '0') or (Ch > '9')) then
  202.             SoundBell(BeepTime,BeepFreq)
  203.          else
  204.          begin
  205.             if First then
  206.             begin
  207.                GS_KeyI_Str := '';
  208.                if EditADate then
  209.                begin
  210.                   GS_KeyI_Str := '          ';
  211.                   GS_KeyI_Str[0] := chr(length(T));
  212.                   for dix := 1 to length(T) do
  213.                      if not (T[dix] in [' ','0'..'9']) then
  214.                         GS_KeyI_Str[dix] := T[dix];
  215.                end;
  216.             end;
  217.             if (GS_KeyI_Ins) then Insert(Ch, GS_KeyI_Str, CPos)
  218.                else if CPos > Length(GS_KeyI_Str) then
  219.                   GS_KeyI_Str := GS_KeyI_Str + Ch
  220.                      else GS_KeyI_Str[CPos] := Ch;
  221.             Inc(CPos);             {Step to the next location in the string}
  222.             if EditADate and not (T[CPos] in [' ','0'..'9']) then
  223.                inc(CPos);
  224.          end;
  225.       end;
  226.       First := False;                 {Set first character flag to false}
  227.       if length(GS_KeyI_Str) > l then {If string is longer than allowed}
  228.       begin
  229.          SoundBell(BeepTime,BeepFreq);
  230.          delete(GS_KeyI_Str,length(GS_KeyI_Str),1);
  231.                                       {Remove the last character in the string}
  232.          dec(CPos);                   {Back up one position}
  233.       end;
  234.       if (CPos > l) then
  235.          if (not Wait_CR) and (Ch <> Kbd_End) then
  236.          begin
  237.             Ch := Kbd_Ret;
  238.             GS_KeyI_Ret := true;      {If field is full and no need to wait}
  239.          end                          {for a carriage return, simulate one}
  240.          else CPos := l;
  241.    until (Ch = Kbd_Ret) or (Ch = Kbd_Esc);
  242.                                       {Continue until Return or Escape pressed}
  243.    if T = GS_KeyI_Str then Modified := false else Modified := true;
  244.    if GS_KeyI_Esc then EditString := T else
  245.                        EditString := GS_KeyI_Str;
  246.                                       {If Escape key pressed, then return the}
  247.                                       {default value.  Otherwise return work}
  248.                                       {string}
  249.    AdditionalKeys := '';
  250. end; { EditString }
  251.  
  252. Procedure SetScreenColors(fgn,hcl,bgn,ifgn,ibgn : byte);
  253. begin
  254.    FGnd := fgn;
  255.    HiLite := hcl;
  256.    BGnd := bgn;
  257.    IFgnd := ifgn;
  258.    IBGnd := ibgn;
  259. end;
  260.  
  261. Procedure SetHiMode;
  262. begin
  263.    TextColor(HiLite);
  264.    TextBackground(Bgnd);
  265. end;
  266.  
  267. Procedure SetIvMode;
  268. begin
  269.    TextColor(IFgnd);
  270.    TextBackground(IBgnd);
  271. end;
  272.  
  273. Procedure SetNmMode;
  274. begin
  275.    TextColor(Fgnd);
  276.    TextBackground(Bgnd);
  277. end;
  278.  
  279. procedure SoundBell( t,h : word);
  280. begin
  281.    Sound(h);
  282.    Delay(t);
  283.    NoSound;
  284. end;
  285.  
  286. procedure WaitForKey;
  287. var
  288.    c  : char;
  289. begin
  290.    c := GetKey;
  291. end;
  292.  
  293. Function GetKey : char;
  294. var
  295.    ch: char;
  296. begin
  297.   Ch := ReadKey;                      {Use TP ReadKey Function}
  298.   If (Ch = #0) then                   {It must be a function key }
  299.   begin
  300.     Ch := ReadKey;                    {So read the function code}
  301.     GS_KeyI_Fuc := true;              {Set function flag}
  302.   end
  303.   else GS_KeyI_Fuc := false;
  304.   GS_KeyI_Chr := Ch;                  {Save in a global variable for general}
  305.                                       {principle.}
  306.   GetKey := Ch;                       {Return character}
  307. end;
  308.  
  309. procedure MakeABox(boxname : string);
  310. var
  311.    x, q      : integer;
  312.    s         : string;
  313.    x1,
  314.    y1,
  315.    x2,
  316.    y2     : integer;
  317.  
  318. begin
  319.    x1 := lo(WindMin)+1;
  320.    x2 := lo(WindMax)+1;
  321.    y1 := hi(WindMin)+1;
  322.    y2 := hi(WindMax)+1;
  323.    SetHiMode;
  324.    window (1,1,80,25);
  325.    FillChar(s[1],80,#205);
  326.    x := succ(x2-x1);
  327.    s[0] := chr(x);
  328.    s[1] := #201;
  329.    if length(boxname) > 0 then
  330.    begin
  331.       if length(boxname) > x-2 then boxname[0] := chr(x-2);
  332.       x := (x-length(boxname)) div 2;
  333.       move(boxname[1],s[x+1],length(boxname));
  334.    end;
  335.    s[length(s)] := #187;
  336.    gotoxy(x1,y1);
  337.    write(s);
  338.    for q := y1+1 to y2-1 do
  339.    begin
  340.       gotoxy(x1,q);
  341.       write(#186);
  342.       gotoxy(x2,q);
  343.       write(#186);
  344.    end;
  345.    gotoxy(x1,y2);
  346.    FillChar(s[1],80,#205);
  347.    s[1] := #200;
  348.    s[0] := chr(pred(length(s)));
  349.    write(s);
  350.    if x2 <> 80 then write(#188);
  351.    window(x1+1,y1+1,x2-1,y2-1);
  352.    SetNmMode;
  353. end;
  354.  
  355. function GS_Pick_Row(InxObj: GSP_IndxColl; var sitem: word): GSP_IndxEtry;
  356. var
  357.    icnt          : longint;
  358.    clth          : word;
  359.    ci, cw, ct, l : longint;
  360.    cj, cis,
  361.    cih           : longint;
  362.    lins,
  363.    wdth, fl,
  364.    x, y, k       : integer;
  365.    chrr          : char;
  366.    inxptr        : GSP_IndxEtry;
  367.    strng         : string;
  368. begin
  369.    GS_KeyI_Fuc := false;
  370.    clth := InxObj^.KeyLength;
  371.    icnt := InxObj^.KeyCount;
  372.    lins := (hi(windmax)) - (hi(windmin));
  373.    wdth := ((lo(windmax)) - (lo(windmin))) + 1;
  374.    if clth > wdth then clth := wdth;
  375.    l := icnt;
  376.    ci := sitem div lins;
  377.    ci := ci * lins;
  378.    fl := sitem;
  379.    cih := 0;
  380.    cis := 1;
  381.    repeat
  382.       if ci + (lins-1) > l then ci := l - (lins-1);
  383.       if ci < 1 then ci := 1;
  384.       if (not GS_KeyI_Fuc) and (fl <= icnt) then cis := (fl - ci)+1;
  385.       cj := ci;
  386.       if ci <> cih then
  387.       begin
  388.          k := 1;
  389.          cih := ci;
  390.          inxptr := InxObj^.PickKey(ci);
  391.          while cj < ci+lins do
  392.          begin
  393.             if cj <= l then
  394.             begin
  395.                y := k;
  396.                x := 2;
  397.                gotoxy(x,y);
  398.                fillchar(strng[1],clth,' ');
  399.                strng := inxptr^.KeyStr;
  400.                strng[0] := chr(clth);
  401.                write(strng);
  402.                inc(cj);
  403.                inc(k);
  404.                inxptr := InxObj^.PickKey(Next_Record);
  405.             end else cj := 9999;
  406.          end;
  407.          gotoxy(1,lins+1);
  408.          if cj-1 < l then write('':(wdth-10) div 2,'-- more --')
  409.             else write('':wdth-1);
  410.       end;
  411.       fl := ci+cis-1;
  412.       inxptr := InxObj^.PickKey(fl);
  413.       fillchar(strng[1],clth,' ');
  414.       strng := inxptr^.KeyStr;
  415.       strng[0] := chr(clth);
  416.       gotoxy(x,cis);
  417.       SetIvMode;
  418.       write(strng);
  419.       gotoxy(x,cis);
  420.       chrr := GetKey;
  421.       gotoxy(x,cis);
  422.       SetNmMode;
  423.       write(strng);
  424.       if GS_KeyI_Fuc then
  425.       begin
  426.          case chrr of
  427.             Kbd_Home : begin
  428.                         ci := 1;
  429.                         cis := 1;
  430.                      end;
  431.             Kbd_End  : begin
  432.                           ci := l;
  433.                           cis := lins;
  434.                        end;
  435.             Kbd_PgUp : begin
  436.                           ci := ci - lins;
  437.                        end;
  438.             Kbd_PgDn : begin
  439.                           ci := ci + lins;
  440.                        end;
  441.             Kbd_UpAr : begin
  442.                           if cis = 1 then ci := ci - 1 else cis := cis - 1;
  443.                        end;
  444.             Kbd_DnAr : begin
  445.                           if cis = lins then ci := ci + 1 else cis := cis + 1;
  446.                        end;
  447.             else SoundBell(BeepTime, BeepFreq);
  448.          end;
  449.          if cis > l then cis := l;
  450.       end else
  451.          if (chrr <> Kbd_Ret) and (chrr <> Kbd_Esc) then
  452.             SoundBell(BeepTime, BeepFreq);
  453.    until chrr in [Kbd_Ret,Kbd_Esc];
  454.    if chrr = Kbd_Ret then
  455.    begin
  456.       sitem := ci+cis-1;
  457.       GS_Pick_Row := inxptr;
  458.    end else GS_Pick_Row := nil;
  459. end;
  460.  
  461. function GS_Pick_Line(InxObj: GSP_IndxColl;var sitem: word): GSP_IndxEtry;
  462. var
  463.    icnt          : longint;
  464.    clth          : word;
  465.    inxptr        : GSP_IndxEtry;
  466.    ci,
  467.    y, k, l       : integer;
  468.    chrr          : char;
  469.    strng         : string[255];
  470. begin
  471.    clth := InxObj^.KeyLength;
  472.    icnt := InxObj^.KeyCount;
  473.    l := icnt;
  474.    y := 1;
  475.    ci := succ(pred(sitem));
  476.    if ci > l then ci := l;
  477.    if ci < 1 then ci := 1;
  478.    repeat
  479.       inxptr := InxObj^.PickKey(Top_Record);
  480.       k := 1;
  481.       while k <= l do
  482.       begin
  483.          gotoxy(((k-1)*clth)+1,y);
  484.          fillchar(strng[1],clth,' ');
  485.          strng := inxptr^.KeyStr;
  486.          strng[0] := chr(clth);
  487.          write(strng);
  488.          inc(k);
  489.          inxptr := InxObj^.PickKey(Next_Record);
  490.       end;
  491.       inxptr := InxObj^.PickKey(ci);
  492.       fillchar(strng[1],clth,' ');
  493.       strng := inxptr^.KeyStr;
  494.       strng[0] := chr(clth);
  495.       gotoxy(((ci-1)*clth)+1,y);
  496.       SetIvMode;
  497.       write(strng);
  498.       gotoxy(((ci-1)*clth)+1,y);
  499.       chrr := GetKey;
  500.       gotoxy(((ci-1)*clth)+1,y);
  501.       SetNmMode;
  502.       write(strng);
  503.       if GS_KeyI_Fuc then
  504.       begin
  505.          case chrr of
  506.             Kbd_Home :  ci := 1;
  507.             Kbd_LfAr :  ci := ci - 1;
  508.             Kbd_RtAr :  ci := ci + 1;
  509.             Kbd_End  :  ci := l;
  510.          end;
  511.          if ci > l then ci := 1;
  512.          if ci < 1 then ci := l;
  513.       end;
  514.    until chrr in [Kbd_Ret,Kbd_Esc];
  515.    if chrr = Kbd_Ret then
  516.    begin
  517.       sitem := ci;
  518.       GS_Pick_Line := inxptr;
  519.    end else GS_Pick_Line := nil;
  520. end;
  521.  
  522. function GS_FindFiles(pth, fname : string; LookElseWhere : boolean): string;
  523. var
  524.    DirObjt : GSP_IndxColl;
  525.    DirEtry : GSP_IndxEtry;
  526.    DirInfo : SearchRec;
  527.    Labl    : string;
  528.    DirNow,
  529.    DirNam,
  530.    DirCur  : PathStr;
  531.    DSt     : DirStr;
  532.    NSt     : NameStr;
  533.    ESt     : ExtStr;
  534.    itms    : integer;
  535.    rfil    : integer;
  536.    rdir    : integer;
  537.    slct    : word;
  538.    lctn    : integer;
  539.    wx1,
  540.    wy1,
  541.    wx2,
  542.    wy2     : integer;
  543.  
  544.   procedure MakeFileTable;
  545.   var
  546.      i : integer;
  547.      d : string;
  548.      v : char;
  549.      u : byte absolute v;
  550.      b : byte;
  551.    begin
  552.       itms := 0;
  553.       FindFirst(Labl, Archive, DirInfo);
  554.       while DosError = 0 do
  555.       begin
  556.          inc(itms);
  557.          DirObjt^.InsertKey(itms, DirInfo.Name);
  558.          FindNext(DirInfo);
  559.       end;
  560.       rfil := itms;
  561.       if LookElseWhere then
  562.       begin
  563.          DirObjt^.ixSortType := NoSort;
  564.          FindFirst('*.*', Directory, DirInfo);
  565.          while DosError = 0 do
  566.          begin
  567.             if (DirInfo.Attr = directory) and (DirInfo.Name <> '.') then
  568.             begin
  569.                inc(itms);
  570.                for i := 1 to length(DirInfo.Name) do
  571.                begin
  572.                   v := DirInfo.Name[i];
  573.                   if v in ['A'..'Z'] then u := u + 32;
  574.                   DirInfo.Name[i] := v;
  575.                end;
  576.                DirObjt^.InsertKey(itms, DirInfo.Name+'\');
  577.             end;
  578.             FindNext(DirInfo);
  579.          end;
  580.          rdir := itms;
  581.          for i := 0 to pred(GS_FileDrvCnt) do
  582.          begin
  583.             if GS_FileDrvTab[i] = 'P' then
  584.             begin
  585.                inc(itms);
  586.                DirObjt^.InsertKey(itms, chr(i+65)+':\');
  587.             end;
  588.          end;
  589.       end;
  590.    end;
  591.  
  592. begin
  593.    wx1 := lo(WindMin)+1;
  594.    wx2 := lo(WindMax)+1;
  595.    wy1 := hi(WindMin)+1;
  596.    wy2 := hi(WindMax)+1;
  597.    GetDir(0,DirNow);
  598.    if pth <> '' then
  599.    begin
  600.       FSplit(pth, DSt, NSt, ESt);
  601.       DSt[0] := pred(DSt[0]);
  602.       (*$I-*) ChDir(DSt) (*$I+*);
  603.    end;
  604.    GetDir(0,DirNam);
  605.    DirCur := DirNam;
  606.    repeat
  607.       DirObjt := New(GSP_IndxColl, Init(12, SortUp));
  608.       if DirNam[length(DirNam)] <> '\' then DirNam := DirNam + '\';
  609.       GoToXY(2,(wy2-wy1)+1);
  610.       Write('Dir = ',DirNam);
  611.       ClrEol;
  612.       Labl := DirNam+fname;
  613.       window(wx1,wy1,wx2,wy2-1);
  614.       MakeFileTable;
  615.       if itms > 0 then
  616.       begin
  617.          slct := 1;
  618.          DirEtry := GS_Pick_Row(DirObjt, slct);
  619.          if DirEtry <> nil then
  620.          begin
  621.             Labl := DirEtry^.KeyStr;
  622.          end else Labl := '';
  623.       end else
  624.       begin
  625.          gotoxy(2,2);
  626.          write('No Files');
  627.          WaitForKey;
  628.          slct := 0;
  629.          Labl := '';
  630.       end;
  631.       window(wx1,wy1,wx2,wy2);
  632.       if slct > rfil then
  633.       begin
  634.          if slct > rdir then (*$I-*) ChDir(DirCur) (*$I+*);
  635.          DirNam := Labl;
  636.          DirNam[0] := pred(DirNam[0]);
  637.          (*$I-*) ChDir(DirNam) (*$I+*);
  638.          GetDir(0,DirNam);
  639.          if slct > rdir then DirCur := DirNam;
  640.       end;
  641.       Dispose(DirObjt, Done);
  642.    until slct <= rfil;
  643.    if DirNam[length(DirNam)] <> '\' then DirNam := DirNam + '\';
  644.    if Labl <> '' then GS_FindFiles := DirNam+Labl
  645.       else GS_FindFiles := '';
  646.    if slct = 0 then GS_FindFiles := '-';
  647.    ChDir(DirNow);
  648. end;
  649.  
  650.  
  651. function GS_Date_Read(x,y: integer;defdate: longint): longint;
  652. var
  653.    t      : string[10];
  654.    tl : integer;
  655.    okDate : boolean;
  656.    jul    : longint;
  657. begin
  658.    EditADate := true;
  659.    Wait_Cr := true;
  660.    t := GS_Date_View(defdate);
  661.    tl := length(t);
  662.    repeat
  663.       SetIVMode;
  664.       t := EditString(t, x, y, tl);
  665.       SetNmMode;
  666.       if GS_KeyI_Esc then
  667.       begin
  668.          GS_Date_Read := defdate;
  669.          exit;
  670.       end;
  671.       gotoxy(x,y);          {Go to start of field screen position}
  672.       write(t,'':tl-length(t));
  673.                         {Rewrite the string on screen in the original color}
  674.       jul := GS_Date_Juln(t);
  675.       if jul <> GS_Date_JulInv then OkDate := true else OkDate := false;
  676.       if not okDate then SoundBell(BeepTime,BeepFreq);
  677.    until okDate;
  678.    EditADate := false;
  679.    GS_Date_Read := jul;
  680. end;
  681.  
  682. begin
  683.    AdditionalKeys := '';
  684.    EditADate := false;
  685.    GS_KeyI_Esc := false;
  686.    GS_KeyI_Fuc := false;
  687.    GS_KeyI_Ins := false;
  688.    GS_KeyI_Ret := false;
  689.    GS_KeyI_Chr := #0;                 {Initialize character to null}
  690.  
  691.                     {Build Drive Table}
  692.    regs.ah := 25;
  693.    regs.Ds := 0;
  694.    regs.Es := 0;
  695.    MsDos(regs);
  696.    cdriv := regs.al;
  697.    regs.dl := cdriv;
  698.    regs.ah := 14;
  699.    regs.Ds := 0;
  700.    regs.Es := 0;
  701.    MsDos(regs);
  702.    GS_FileDrvCnt := regs.al;
  703.    tdrv := 0;
  704.    while tdrv < GS_FileDrvCnt do
  705.    begin
  706.       regs.dl := tdrv;
  707.       regs.ah := 14;
  708.       regs.Ds := 0;
  709.       regs.Es := 0;
  710.       MsDos(regs);
  711.       regs.ah := 25;
  712.       regs.Ds := 0;
  713.       regs.Es := 0;
  714.       MsDos(regs);
  715.       if tdrv = regs.al then GS_FileDrvTab[tdrv] := 'P'
  716.          else GS_FileDrvTab[tdrv] := ' ';
  717.       inc(tdrv);
  718.    end;
  719.    regs.dl := cdriv;
  720.    regs.ah := 14;
  721.    regs.Ds := 0;
  722.    regs.Es := 0;
  723.    MsDos(regs);
  724. end.
  725.